home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Internet Tools 1993 July / Internet Tools.iso / RockRidge / mail / metamail / contrib / emacs / Epoch-richtext next >
Encoding:
Text File  |  1992-03-26  |  4.3 KB  |  160 lines
  1. The following was provided by  Dave Edmondson <davided@sco.COM>.  It is a first step towards native (built-in) support for the MIME 'richtext' type in a GNU Epoch window.
  2. ----------------------------------------------------------------
  3. i did knock up this small piece of lisp, which given a buffer in
  4. richtext format, makes an attempt at showing it as it should be.  it's
  5. pretty grungy, but might be useful.  note that the buffer must contain
  6. nothing except the richtext stuff - it doesn't parse a mail message or
  7. anything.
  8.  
  9. dave.
  10.  
  11. (setq roman-font "-*-helvetica-medium-r-*-14-*")
  12. (setq bold-font "-*-helvetica-bold-r-*-14-*")
  13. (setq italic-font "-*-helvetica-medium-o-*-14-*")
  14.  
  15. (setq rt-roman (epoch::make-style))
  16. (epoch::set-style-font rt-roman roman-font)
  17.  
  18. (setq rt-bold (epoch::make-style))
  19. (epoch::set-style-font rt-bold bold-font)
  20.  
  21. (setq rt-italic (epoch::make-style))
  22. (epoch::set-style-font rt-italic italic-font)
  23.  
  24. (setq rt-underline (epoch::make-style))
  25. (epoch::set-style-font rt-underline roman-font)
  26. (epoch::set-style-underline rt-underline (foreground))
  27.  
  28. (defun rt-buffer ()
  29.   "given that the current buffer is in richtext format, make it look
  30. presentable using buttons"
  31.   (interactive)
  32.   
  33.   (epoch::font roman-font)
  34.  
  35.   ;; remove all of the newlines - they are spurious
  36.   (goto-char (point-min))
  37.   (replace-regexp "\n" "")
  38.  
  39.   (goto-char (point-min))
  40.  
  41.   (while (re-search-forward "<\\([^>]*\\)>" nil t)
  42.     (progn
  43.       (setq command (buffer-substring (match-beginning 1) (match-end 1)))
  44.       (rt-parse-command command (match-beginning 0))
  45.       )
  46.     )
  47.   (goto-char (point-min))
  48.   (replace-regexp "<[^>]*>" "")
  49.   )
  50.  
  51. (defun rt-parse-command (command place)
  52.   "given a richtext command, do something"
  53.   (if (string-equal "nl" command)
  54.       (insert "\n");
  55.     )
  56.   (if (string-equal "lt" command)
  57.       ;(insert "<")
  58.       (message "oops - <")
  59.     )
  60.   (if (string-equal "np" command)
  61.       (insert "\n ")
  62.     )
  63.   (if (string-equal "bold" command)
  64.       (setq bold-start place)
  65.     )
  66.   (if (string-equal "/bold" command)
  67.       (epoch::add-button bold-start place rt-bold)
  68.     )
  69.   (if (string-equal "italic" command)
  70.       (setq italic-start place)
  71.     )
  72.   (if (string-equal "/italic" command)
  73.       (epoch::add-button italic-start place rt-italic)
  74.     )
  75.   (if (string-equal "underline" command)
  76.       (setq underline-start place)
  77.     )
  78.   (if (string-equal "/underline" command)
  79.       (epoch::add-button underline-start place rt-underline)
  80.     )
  81.   (if (string-equal "excerpt" command)
  82.       (setq excerpt-start place)
  83.     )
  84.   (if (string-equal "/excerpt" command)
  85.       (save-excursion
  86.     (narrow-to-region excerpt-start place)
  87.     (goto-char excerpt-start)
  88.     (replace-regexp "^" "> ")
  89.     (widen)
  90.     )
  91.     )
  92.   (if (string-equal "signature" command)
  93.       (setq signature-start place)
  94.     )
  95.   (if (string-equal "/signature" command)
  96.       (save-excursion
  97.     (narrow-to-region signature-start place)
  98.     (goto-char signature-start)
  99.     (replace-regexp "^" "+ ")
  100.     (widen)
  101.     )
  102.     )
  103.   (if (string-equal "center" command)
  104.       (setq center-start place)
  105.     )
  106.   (if (string-equal "/center" command)
  107.       (center-region center-start place)
  108.     )
  109.  
  110.   ;; things that richtext.c know about that i don't
  111.   (if (or
  112.        (string-equal "bigger" command)
  113.        (string-equal "/bigger" command)
  114.        )
  115.       (message "Don't support bigger yet.")
  116.     )
  117.   (if (or
  118.        (string-equal "flushleft" command)
  119.        (string-equal "/flushleft" command)
  120.        )
  121.       (message "Don't support flushleft yet.")
  122.     )
  123.   (if (or
  124.        (string-equal "flushright" command)
  125.        (string-equal "/flushright" command)
  126.        )
  127.       (message "Don't support flushright yet.")
  128.     )
  129.   (if (or
  130.        (string-equal "indent" command)
  131.        (string-equal "/indent" command)
  132.        )
  133.       (message "Don't support indent yet.");
  134.     )
  135.   (if (or
  136.        (string-equal "indentright" command)
  137.        (string-equal "/indentright" command)
  138.        )
  139.       (message "Don't support indentright yet.");
  140.     )
  141.   (if (or
  142.        (string-equal "outdent" command)
  143.        (string-equal "/outdent" command)
  144.        )
  145.       (message "Don't support outdent yet.");
  146.     )
  147.   (if (or
  148.        (string-equal "outdentright" command)
  149.        (string-equal "/outdentright" command)
  150.        )
  151.       (message "Don't support outdentright yet.");
  152.     )
  153.   (if (or
  154.        (string-equal "paragraph" command)
  155.        (string-equal "/paragraph" command)
  156.        )
  157.       (message "Don't support paragraph yet.");
  158.     )
  159.   )
  160.